home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / MEMOIMPL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-30  |  9.6 KB  |  402 lines

  1. unit MemoImpl;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  7.   ComServ, StdVCL, AXCtrls, DelLib;
  8.  
  9. type
  10.   TMemoX = class(TActiveXControl, IMemoX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TMemo;
  14.     FEvents: IMemoXEvents;
  15.     procedure ChangeEvent(Sender: TObject);
  16.     procedure ClickEvent(Sender: TObject);
  17.     procedure DblClickEvent(Sender: TObject);
  18.     procedure KeyPressEvent(Sender: TObject; var Key: Char);
  19.   protected
  20.     { Protected declarations }
  21.     procedure InitializeControl; override;
  22.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  23.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  24.     function Get_Alignment: TxAlignment; safecall;
  25.     function Get_Color: TColor; safecall;
  26.     function Get_Ctl3D: WordBool; safecall;
  27.     function Get_Cursor: Smallint; safecall;
  28.     function Get_DragCursor: Smallint; safecall;
  29.     function Get_Enabled: WordBool; safecall;
  30.     function Get_Font: Font; safecall;
  31.     function Get_HideSelection: WordBool; safecall;
  32.     function Get_ImeName: WideString; safecall;
  33.     function Get_Lines: IStrings; safecall;
  34.     function Get_MaxLength: Integer; safecall;
  35.     function Get_Modified: WordBool; safecall;
  36.     function Get_OEMConvert: WordBool; safecall;
  37.     function Get_ParentColor: WordBool; safecall;
  38.     function Get_ReadOnly: WordBool; safecall;
  39.     function Get_SelLength: Integer; safecall;
  40.     function Get_SelStart: Integer; safecall;
  41.     function Get_SelText: WideString; safecall;
  42.     function Get_Text: WideString; safecall;
  43.     function Get_Visible: WordBool; safecall;
  44.     function Get_WantReturns: WordBool; safecall;
  45.     function Get_WantTabs: WordBool; safecall;
  46.     function Get_WordWrap: WordBool; safecall;
  47.     procedure AboutBox; safecall;
  48.     procedure Clear; safecall;
  49.     procedure ClearSelection; safecall;
  50.     procedure CopyToClipboard; safecall;
  51.     procedure CutToClipboard; safecall;
  52.     procedure PasteFromClipboard; safecall;
  53.     procedure SelectAll; safecall;
  54.     procedure Set_Alignment(Value: TxAlignment); safecall;
  55.     procedure Set_Color(Value: TColor); safecall;
  56.     procedure Set_Ctl3D(Value: WordBool); safecall;
  57.     procedure Set_Cursor(Value: Smallint); safecall;
  58.     procedure Set_DragCursor(Value: Smallint); safecall;
  59.     procedure Set_Enabled(Value: WordBool); safecall;
  60.     procedure Set_Font(const Value: Font); safecall;
  61.     procedure Set_HideSelection(Value: WordBool); safecall;
  62.     procedure Set_ImeName(const Value: WideString); safecall;
  63.     procedure Set_Lines(const Value: IStrings); safecall;
  64.     procedure Set_MaxLength(Value: Integer); safecall;
  65.     procedure Set_Modified(Value: WordBool); safecall;
  66.     procedure Set_OEMConvert(Value: WordBool); safecall;
  67.     procedure Set_ParentColor(Value: WordBool); safecall;
  68.     procedure Set_ReadOnly(Value: WordBool); safecall;
  69.     procedure Set_SelLength(Value: Integer); safecall;
  70.     procedure Set_SelStart(Value: Integer); safecall;
  71.     procedure Set_SelText(const Value: WideString); safecall;
  72.     procedure Set_Text(const Value: WideString); safecall;
  73.     procedure Set_Visible(Value: WordBool); safecall;
  74.     procedure Set_WantReturns(Value: WordBool); safecall;
  75.     procedure Set_WantTabs(Value: WordBool); safecall;
  76.     procedure Set_WordWrap(Value: WordBool); safecall;
  77.   end;
  78.  
  79. implementation
  80. uses MemoPg;
  81. { TMemoX }
  82.  
  83. procedure TMemoX.InitializeControl;
  84. begin
  85.   FDelphiControl := Control as TMemo;
  86.   FDelphiControl.OnChange := ChangeEvent;
  87.   FDelphiControl.OnClick := ClickEvent;
  88.   FDelphiControl.OnDblClick := DblClickEvent;
  89.   FDelphiControl.OnKeyPress := KeyPressEvent;
  90. end;
  91.  
  92. procedure TMemoX.EventSinkChanged(const EventSink: IUnknown);
  93. begin
  94.   FEvents := EventSink as IMemoXEvents;
  95. end;
  96.  
  97. procedure TMemoX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  98. begin
  99.   { Define property pages here.  Property pages are defined by calling
  100.     DefinePropertyPage with the class id of the page.  For example,
  101.       DefinePropertyPage(Class_MemoXPage); }
  102. end;
  103.  
  104. function TMemoX.Get_Alignment: TxAlignment;
  105. begin
  106.   Result := Ord(FDelphiControl.Alignment);
  107. end;
  108.  
  109. function TMemoX.Get_Color: TColor;
  110. begin
  111.   Result := FDelphiControl.Color;
  112. end;
  113.  
  114. function TMemoX.Get_Ctl3D: WordBool;
  115. begin
  116.   Result := FDelphiControl.Ctl3D;
  117. end;
  118.  
  119. function TMemoX.Get_Cursor: Smallint;
  120. begin
  121.   Result := Smallint(FDelphiControl.Cursor);
  122. end;
  123.  
  124. function TMemoX.Get_DragCursor: Smallint;
  125. begin
  126.   Result := Smallint(FDelphiControl.DragCursor);
  127. end;
  128.  
  129. function TMemoX.Get_Enabled: WordBool;
  130. begin
  131.   Result := FDelphiControl.Enabled;
  132. end;
  133.  
  134. function TMemoX.Get_Font: Font;
  135. begin
  136.   GetOleFont(FDelphiControl.Font, Result);
  137. end;
  138.  
  139. function TMemoX.Get_HideSelection: WordBool;
  140. begin
  141.   Result := FDelphiControl.HideSelection;
  142. end;
  143.  
  144. function TMemoX.Get_ImeName: WideString;
  145. begin
  146.   Result := WideString(FDelphiControl.ImeName);
  147. end;
  148.  
  149. function TMemoX.Get_Lines: IStrings;
  150. begin
  151.   GetOleStrings(FDelphiControl.Lines, Result);
  152. end;
  153.  
  154. function TMemoX.Get_MaxLength: Integer;
  155. begin
  156.   Result := FDelphiControl.MaxLength;
  157. end;
  158.  
  159. function TMemoX.Get_Modified: WordBool;
  160. begin
  161.   Result := FDelphiControl.Modified;
  162. end;
  163.  
  164. function TMemoX.Get_OEMConvert: WordBool;
  165. begin
  166.   Result := FDelphiControl.OEMConvert;
  167. end;
  168.  
  169. function TMemoX.Get_ParentColor: WordBool;
  170. begin
  171.   Result := FDelphiControl.ParentColor;
  172. end;
  173.  
  174. function TMemoX.Get_ReadOnly: WordBool;
  175. begin
  176.   Result := FDelphiControl.ReadOnly;
  177. end;
  178.  
  179. function TMemoX.Get_SelLength: Integer;
  180. begin
  181.   Result := FDelphiControl.SelLength;
  182. end;
  183.  
  184. function TMemoX.Get_SelStart: Integer;
  185. begin
  186.   Result := FDelphiControl.SelStart;
  187. end;
  188.  
  189. function TMemoX.Get_SelText: WideString;
  190. begin
  191.   Result := WideString(FDelphiControl.SelText);
  192. end;
  193.  
  194. function TMemoX.Get_Text: WideString;
  195. begin
  196.   Result := WideString(FDelphiControl.Text);
  197. end;
  198.  
  199. function TMemoX.Get_Visible: WordBool;
  200. begin
  201.   Result := FDelphiControl.Visible;
  202. end;
  203.  
  204. function TMemoX.Get_WantReturns: WordBool;
  205. begin
  206.   Result := FDelphiControl.WantReturns;
  207. end;
  208.  
  209. function TMemoX.Get_WantTabs: WordBool;
  210. begin
  211.   Result := FDelphiControl.WantTabs;
  212. end;
  213.  
  214. function TMemoX.Get_WordWrap: WordBool;
  215. begin
  216.   Result := FDelphiControl.WordWrap;
  217. end;
  218.  
  219. procedure TMemoX.AboutBox;
  220. begin
  221.   ShowMemoXAbout;
  222. end;
  223.  
  224. procedure TMemoX.Clear;
  225. begin
  226.  
  227. end;
  228.  
  229. procedure TMemoX.ClearSelection;
  230. begin
  231.  
  232. end;
  233.  
  234. procedure TMemoX.CopyToClipboard;
  235. begin
  236.  
  237. end;
  238.  
  239. procedure TMemoX.CutToClipboard;
  240. begin
  241.  
  242. end;
  243.  
  244. procedure TMemoX.PasteFromClipboard;
  245. begin
  246.  
  247. end;
  248.  
  249. procedure TMemoX.SelectAll;
  250. begin
  251.  
  252. end;
  253.  
  254. procedure TMemoX.Set_Alignment(Value: TxAlignment);
  255. begin
  256.   FDelphiControl.Alignment := TAlignment(Value);
  257. end;
  258.  
  259. procedure TMemoX.Set_Color(Value: TColor);
  260. begin
  261.   FDelphiControl.Color := Value;
  262. end;
  263.  
  264. procedure TMemoX.Set_Ctl3D(Value: WordBool);
  265. begin
  266.   FDelphiControl.Ctl3D := Value;
  267. end;
  268.  
  269. procedure TMemoX.Set_Cursor(Value: Smallint);
  270. begin
  271.   FDelphiControl.Cursor := TCursor(Value);
  272. end;
  273.  
  274. procedure TMemoX.Set_DragCursor(Value: Smallint);
  275. begin
  276.   FDelphiControl.DragCursor := TCursor(Value);
  277. end;
  278.  
  279. procedure TMemoX.Set_Enabled(Value: WordBool);
  280. begin
  281.   FDelphiControl.Enabled := Value;
  282. end;
  283.  
  284. procedure TMemoX.Set_Font(const Value: Font);
  285. begin
  286.   SetOleFont(FDelphiControl.Font, Value);
  287. end;
  288.  
  289. procedure TMemoX.Set_HideSelection(Value: WordBool);
  290. begin
  291.   FDelphiControl.HideSelection := Value;
  292. end;
  293.  
  294. procedure TMemoX.Set_ImeName(const Value: WideString);
  295. begin
  296.   FDelphiControl.ImeName := TImeName(Value);
  297. end;
  298.  
  299. procedure TMemoX.Set_Lines(const Value: IStrings);
  300. begin
  301.   SetOleStrings(FDelphiControl.Lines, Value);
  302. end;
  303.  
  304. procedure TMemoX.Set_MaxLength(Value: Integer);
  305. begin
  306.   FDelphiControl.MaxLength := Value;
  307. end;
  308.  
  309. procedure TMemoX.Set_Modified(Value: WordBool);
  310. begin
  311.   FDelphiControl.Modified := Value;
  312. end;
  313.  
  314. procedure TMemoX.Set_OEMConvert(Value: WordBool);
  315. begin
  316.   FDelphiControl.OEMConvert := Value;
  317. end;
  318.  
  319. procedure TMemoX.Set_ParentColor(Value: WordBool);
  320. begin
  321.   FDelphiControl.ParentColor := Value;
  322. end;
  323.  
  324. procedure TMemoX.Set_ReadOnly(Value: WordBool);
  325. begin
  326.   FDelphiControl.ReadOnly := Value;
  327. end;
  328.  
  329. procedure TMemoX.Set_SelLength(Value: Integer);
  330. begin
  331.   FDelphiControl.SelLength := Value;
  332. end;
  333.  
  334. procedure TMemoX.Set_SelStart(Value: Integer);
  335. begin
  336.   FDelphiControl.SelStart := Value;
  337. end;
  338.  
  339. procedure TMemoX.Set_SelText(const Value: WideString);
  340. begin
  341.   FDelphiControl.SelText := String(Value);
  342. end;
  343.  
  344. procedure TMemoX.Set_Text(const Value: WideString);
  345. begin
  346.   FDelphiControl.Text := TCaption(Value);
  347. end;
  348.  
  349. procedure TMemoX.Set_Visible(Value: WordBool);
  350. begin
  351.   FDelphiControl.Visible := Value;
  352. end;
  353.  
  354. procedure TMemoX.Set_WantReturns(Value: WordBool);
  355. begin
  356.   FDelphiControl.WantReturns := Value;
  357. end;
  358.  
  359. procedure TMemoX.Set_WantTabs(Value: WordBool);
  360. begin
  361.   FDelphiControl.WantTabs := Value;
  362. end;
  363.  
  364. procedure TMemoX.Set_WordWrap(Value: WordBool);
  365. begin
  366.   FDelphiControl.WordWrap := Value;
  367. end;
  368.  
  369. procedure TMemoX.ChangeEvent(Sender: TObject);
  370. begin
  371.   if FEvents <> nil then FEvents.OnChange;
  372. end;
  373.  
  374. procedure TMemoX.ClickEvent(Sender: TObject);
  375. begin
  376.   if FEvents <> nil then FEvents.OnClick;
  377. end;
  378.  
  379. procedure TMemoX.DblClickEvent(Sender: TObject);
  380. begin
  381.   if FEvents <> nil then FEvents.OnDblClick;
  382. end;
  383.  
  384. procedure TMemoX.KeyPressEvent(Sender: TObject; var Key: Char);
  385. var
  386.   TempKey: Smallint;
  387. begin
  388.   TempKey := Smallint(Key);
  389.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  390.   Key := Char(TempKey);
  391. end;
  392.  
  393. initialization
  394.   TActiveXControlFactory.Create(
  395.     ComServer,
  396.     TMemoX,
  397.     TMemo,
  398.     Class_MemoX,
  399.     13,
  400.     '{5A56599B-7975-11D0-BE02-00A024D1875C}');
  401. end.
  402.